home *** CD-ROM | disk | FTP | other *** search
/ MacWorld 1999 March - Disc 1 / Macworld (1999-03) (Disk 1).dmg / Shareware World / Utilities / Text Processing / Alpha / Tcl / SystemCode / win.tcl < prev   
Encoding:
Text File  |  1998-11-21  |  13.4 KB  |  537 lines  |  [TEXT/ALFA]
  1. ## -*-Tcl-*- (install)
  2.  # ###################################################################
  3.  #  Chuck's Additions - an Alpha hack
  4.  #
  5.  #  FILE: "win.tcl"
  6.  #                                    created: 4/6/98
  7.  #                                last update: 09/06/98 {21:42:26 PM}
  8.  #  Author: Chuck Gregory
  9.  #  E-mail: <cgregory@mail.arc.nasa.gov>
  10.  #    mail: Logicon
  11.  #          NASA Ames Research Center, Moffett Field, CA  94035
  12.  #
  13.  #  Description:
  14.  #
  15.  #    Window handling routines. All procs are bound in AlphaBits.tcl.
  16.  #      Recommend the following global interface preference settings:
  17.  #
  18.  #                                MacOS 8.0     MacOS < 8
  19.  #                  defLeft             6             0
  20.  #                  defTop            41            38
  21.  #                  defWidth           510           510
  22.  #                  horMargin             6             2
  23.  #                  tileHeight      [707]           426
  24.  #                  tileLeft             6             0
  25.  #                  tileMargin        22            20
  26.  #                  tileTop            41            38
  27.  #                  tileWidth        [1014]           640
  28.  #
  29.  #  History:
  30.  #
  31.  #  modified  by   rev  reason
  32.  #  --------  ---  ---  -----------
  33.  #  04/06/98            7.1b6 original
  34.  #  04/08/98  czg  1.0  modified for MacOS 8
  35.  #  07/15/98  VMD       removed lisp'ish functions
  36.  #  07/21/98  czg  1.1  fixed margin bugs in shrinkLeft & shrinkRight;
  37.  #                    documented prefs recommendations
  38.  # ###################################################################
  39.  ##
  40.  
  41. proc shrinkHigh {} {
  42.     global numWinsToTile tileTop tileHeight tileMargin
  43.     set names [winNames -f]
  44.     set numWins [llength $names]
  45.     if ($numWins<2) {set numWins 2}
  46.     if ($numWins>$numWinsToTile) {set numWins $numWinsToTile}
  47.     set width [lindex [getGeometry] 2]
  48.     set height [expr {($tileHeight - $tileMargin) / $numWins}]
  49.     set text [getGeometry]
  50.     set left [lindex $text 0]
  51.     sizeWin $width $height
  52.     moveWin $left $tileTop
  53. }
  54.  
  55. proc shrinkLow {} {
  56.     global numWinsToTile tileTop tileHeight tileMargin
  57.     set names [winNames -f]
  58.     set numWins [llength $names]
  59.     if ($numWins<2) {set numWins 2}
  60.     if ($numWins>$numWinsToTile) {set numWins $numWinsToTile}
  61.     set width [lindex [getGeometry] 2]
  62.     set height [expr {($tileHeight - $tileMargin) / $numWins}]
  63.     set text [getGeometry]
  64.     set left [lindex $text 0]
  65.     sizeWin $width $height
  66.     moveWin $left [expr {$tileTop + $height + $tileMargin}]
  67. }
  68.  
  69. proc singlePage {} {shrinkFull}
  70.  
  71. proc shrinkFull {} {
  72.     global tileTop tileHeight tileLeft defWidth
  73.     moveWin $tileLeft $tileTop
  74.     sizeWin $defWidth $tileHeight
  75. }
  76.  
  77. proc shrinkLeft {} {
  78.     global horMargin tileWidth tileLeft
  79.     set width [expr {($tileWidth-$horMargin)/2}]
  80.     set height [lindex [getGeometry] 3]
  81.     set text [getGeometry]
  82.     set top [lindex $text 1]
  83.     moveWin $tileLeft $top
  84.     sizeWin $width $height
  85. }
  86.  
  87. proc shrinkRight {} {
  88.     global horMargin tileWidth tileLeft
  89.     set width [expr {($tileWidth-$horMargin)/2}]
  90.     set height [lindex [getGeometry] 3]
  91.     set text [getGeometry]
  92.     set top [lindex $text 1]
  93.     moveWin [expr {$tileLeft + $width + $horMargin}] $top
  94.     sizeWin $width $height
  95. }
  96.  
  97. proc swapWithNext {} {
  98.     set files [winNames]
  99.     if {[llength $files] < 2} return
  100.     bringToFront [lindex $files 1]
  101. }
  102.     
  103.  
  104.  
  105. proc nextWindow {} {
  106.     global win::Active 
  107.     set files [winNames -f]
  108.     if {[llength $files] < 2} {return}
  109.     set f [lindex $files 0]
  110.     regsub -all {[][]} $f {\\\0} f
  111.     set aind [lsearch -exact ${win::Active} $f]
  112.     if {$aind < 0} {error "No win '$f'"}
  113.     set rng [lrange ${win::Active} 0 [expr {$aind-1}]]
  114.     set win::Active [concat [lrange ${win::Active} $aind end] $rng]
  115.     set win::Active [lrange ${win::Active} 1 end]
  116.     lappend win::Active $f
  117.     regsub -all {\\([][])} [lindex ${win::Active} 0] {\1} w
  118.     bringToFront $w
  119. }
  120.  
  121.  
  122. proc prevWindow {} {
  123.     global win::Active 
  124.     set files [winNames -f]
  125.     if {[llength $files] < 2} {return}
  126.     set f [lindex $files 0]
  127.     regsub -all {[][]} $f {\\\0} f
  128.     set aind [lsearch -exact ${win::Active} $f]
  129.     if {$aind < 0} {error "No win '$f'"}
  130.     set rng [lrange ${win::Active} 0 [expr {$aind-1}]]
  131.     set win::Active [concat [lrange ${win::Active} $aind end] $rng]
  132.     set f2 [lindex [lrange ${win::Active} end end] 0]
  133.     set win::Active [lreplace ${win::Active} end end]
  134.     set win::Active [linsert ${win::Active} 0 $f2]
  135.     regsub -all {\\([][])} $f2 {\1} f2
  136.     bringToFront $f2
  137. }
  138.  
  139. proc bufferOtherWindow {} {
  140.     global tileHeight tileTop tileWidth tileMargin
  141.     global numWinsToTile
  142.     set margin $tileMargin
  143.     set win [win::Current]
  144.     set numWins 2
  145.     set hor 2
  146.     set height [expr {($tileHeight/$numWins)-$margin}]
  147.     set height [expr {$height + $margin / $numWins}]
  148.     set width $tileWidth
  149.     set ver $tileTop
  150.     
  151.     if {[llength [winNames]] < 2} {message "No other window!"; return}
  152.     set next [nextWin]
  153.     set res [statusPrompt "Window other half ($next): " winComp]
  154.     if {![string length $res]} {
  155.         set res $next
  156.     }
  157.     
  158.     set geo [getGeometry]
  159.     if {([lindex $geo 2] != $width) || ([lindex $geo 3] != $height) || ([lindex $geo 0] != $hor) || (([lindex $geo 1] != $ver) && ([lindex $geo 1] != [expr {$ver + $height + $margin}]))} {
  160.         moveWin $win 1000 0
  161.         sizeWin $win $width $height
  162.         moveWin $win $hor $ver
  163.         incr ver [expr {$height + $margin}]
  164.     } else {
  165.         if {[lindex $geo 1] == $ver} {
  166.             incr ver [expr {$height + $margin}]
  167.         } 
  168.     }
  169.     
  170.     set geo [getGeometry $res]
  171.     if {([lindex $geo 0] != $hor) || ([lindex $geo 1] != $ver) || ([lindex $geo 2] != $width) || ([lindex $geo 3] != $height)} {
  172.         moveWin $res 1000 0
  173.         sizeWin $res $width $height
  174.         moveWin $res $hor $ver
  175.     }
  176.     bringToFront $res
  177. }
  178.  
  179.         
  180.     
  181.         
  182.  
  183. proc winvertically {} {
  184.     global tileHeight tileTop tileWidth tileMargin
  185.     global numWinsToTile defWidth tileLeft
  186.     set margin $tileMargin
  187.     set names [winNames -f]
  188.     set numWins [llength $names]
  189.     if ($numWins<=1) return
  190.     if ($numWins>$numWinsToTile) {set numWins $numWinsToTile}
  191.     if {$numWins == 0} {return}
  192.     set height [expr {($tileHeight/$numWins)-$margin}]
  193.     set height [expr {$height + $margin / $numWins}]
  194.     set width $defWidth
  195.     set ver $tileTop
  196.     for {set i 0} {$i < $numWins} {incr i} {
  197.         sizeWin [lindex $names $i] $width $height
  198.         moveWin [lindex $names $i] $tileLeft $ver
  199.         set ver [expr {$ver+$margin+$height}]
  200.     }
  201. }
  202.  
  203. proc winhorizontally {} {
  204.     global tileHeight tileLeft tileWidth tileTop numWinsToTile horMargin
  205.     set names [winNames -f]
  206.     set numWins [llength $names]
  207.     if ($numWins<=1) return
  208.     if ($numWins>$numWinsToTile) {set numWins $numWinsToTile}
  209.     if {$numWins == 0} {return}
  210.     set width [expr {($tileWidth/$numWins)-$horMargin}]
  211.     set width [expr {$width + $horMargin / $numWins}]
  212.     set height $tileHeight
  213.     set hor $tileLeft
  214.     for {set i 0} {$i < $numWins} {incr i} {
  215.         sizeWin [lindex $names $i] $width $height
  216.         moveWin [lindex $names $i] $hor $tileTop
  217.         set hor [expr {$hor+$width+$horMargin}]
  218.     }
  219. }
  220.  
  221.  
  222. proc winunequalHor {} {
  223.     global tileLeft tileHeight tileWidth tileTop numWinsToTile horMargin
  224.     global tileProportion
  225.     set names [winNames -f]
  226.     sizeWin [lindex $names 0] \
  227.       [expr {$tileProportion*$tileWidth - $horMargin/2}] $tileHeight
  228.     moveWin [lindex $names 0] $tileLeft $tileTop
  229.     sizeWin [lindex $names 1] \
  230.       [expr {(1-$tileProportion)*$tileWidth - $horMargin/2}] $tileHeight
  231.     moveWin [lindex $names 1] \
  232.       [expr {$tileLeft + $tileProportion*$tileWidth + $horMargin/2}] $tileTop
  233. }
  234.  
  235.  
  236. proc winunequalVert {} {
  237.     global tileLeft tileMargin tileHeight tileWidth tileTop numWinsToTile
  238.     global horMargin tileProportion defWidth
  239.     set names [winNames -f]
  240.     set height [expr {$tileHeight + $tileMargin}]
  241.     sizeWin [lindex $names 0] \
  242.       $defWidth [expr {$tileProportion*$height - $tileMargin}]
  243.     moveWin [lindex $names 0] $tileLeft $tileTop
  244.     sizeWin [lindex $names 1] \
  245.       $defWidth [expr {(1-$tileProportion)*$height - $tileMargin}]
  246.     moveWin [lindex $names 1] \
  247.       $tileLeft [expr {$tileTop + $tileProportion*$height}]
  248. }
  249.  
  250.  
  251. proc wintiled {} {
  252.     global tileHeight tileWidth numWinsToTile tileTop
  253.     set xPan 8
  254.     set yPan 10
  255.     set xMarg 2
  256.     set yMarg $tileTop
  257.     set yMax 50
  258.     set names [winNames -f]
  259.     set numWins [llength $names]
  260.     if ($numWins<1) return
  261.     set line 0    
  262.     set height [expr {$tileHeight-$yPan*($numWins-1)}]
  263.     set width [expr {$tileWidth-$xPan*($numWins-1)}]
  264.     
  265.     for {set i 0} {$i < $numWins} {incr i} {
  266.         moveWin [lindex $names $i] [expr {$xMarg+$i*$xPan}] [expr {$yMarg+$line}]
  267.         set line [expr {$line+$yPan}]
  268.         if ($line>$yMax) {set line 0}
  269.         sizeWin [lindex $names $i] $width $height
  270.     }
  271. }
  272.  
  273.  
  274. proc winoverlay {} {
  275.     global defHeight defWidth numWinsToTile tileTop
  276.     set names [winNames -f]
  277.     set numWins [llength $names]
  278.     if ($numWins<1) return
  279.     for {set i 0} {$i < $numWins} {incr i} {
  280.         moveWin [lindex $names $i] 2 $tileTop
  281.         sizeWin [lindex $names $i] $defWidth $defHeight
  282.     }
  283. }
  284.  
  285.  
  286. proc chooseAWindow {} {
  287.     set name [listpick [lsort -ignore [winNames]]]
  288.     if {[string length $name]} {
  289.         bringToFront $name
  290.         if {[icon -q]} { icon -f $name -o }
  291.        }
  292. }
  293.  
  294.  
  295. proc nextWin {} {
  296.     global win::Active 
  297.     set files [winNames -f]
  298.     if {[llength $files] < 2} {return ""}
  299.     set f [lindex $files 0]
  300.     set aind [lsearch ${win::Active} $f]
  301.     if {$aind < 0} {error "No win '$f'"}
  302.     if {[incr aind] < [llength ${win::Active}]} {
  303.         return [file tail [lindex ${win::Active} $aind]]
  304.     } else {
  305.         return [file tail [lindex ${win::Active} 0]]
  306.     }
  307. }
  308.  
  309. proc winComp {curr c} {
  310.     if {$c != "\t"} {return $c}
  311.     
  312.     set matches {}
  313.     foreach w [winNames] {
  314.         if {[string match "$curr*" $w]} {
  315.             lappend matches $w
  316.         }
  317.     }
  318.     if {![llength $matches]} {
  319.         beep
  320.     } else {
  321.         return [string range [largestPrefix $matches] [string length $curr] end]
  322.     }
  323.     return ""
  324. }
  325.  
  326. proc killWindowStatus {} {
  327.     if {![llength [winNames]]} return
  328.     
  329.     set def [win::CurrentTail]
  330.     set res [statusPrompt "Kill window ($def): " winComp]
  331.  
  332.     if {[string length $res]} {
  333.         catch {bringToFront $res; killWindow}
  334.     } else {killWindow}
  335. }
  336.  
  337. proc chooseWindowStatus {} {
  338.     if {[llength [winNames]] < 2} {message "No other window!"; return}
  339.     set next [nextWin]
  340.     set res [statusPrompt "Window ($next): " winComp]
  341.     if {[string length $res]} {
  342.         catch {bringToFront $res}
  343.     } else {
  344.         catch {bringToFront $next}
  345.     }
  346. }
  347.  
  348. proc iconify {} { 
  349.     icon -t 
  350.     if {[icon -q]} {
  351.         nextWindow
  352.     }
  353. }
  354.  
  355. proc zoom {} {
  356.     global nzmState tileHeight tileWidth zoomedGeo tileTop tileLeft
  357.     
  358.     set win [win::Current]
  359.     if {[info exists nzmState($win)]} {
  360.         if {[getGeometry] == $zoomedGeo} {
  361.             set state $nzmState($win)
  362.             moveWin [lindex $state 0] [lindex $state 1]
  363.             sizeWin [lindex $state 2] [lindex $state 3]
  364.             unset nzmState($win)
  365.             return
  366.         }
  367.     } 
  368.  
  369.     set nzmState($win) [getGeometry]
  370.     moveWin $tileLeft $tileTop
  371.     sizeWin $tileWidth $tileHeight
  372.  
  373.     if {![info exists zoomedGeo]} {
  374.         set zoomedGeo [getGeometry]
  375.     }
  376. }
  377.  
  378. #================================================================================
  379.  
  380. proc otherThing {} {
  381.     set win [win::Current]
  382.     getWinInfo -w $win arr
  383.     if {$arr(split)} {
  384.         otherPane
  385.     } else {
  386.         swapWithNext
  387.     }
  388. }
  389.  
  390. proc winAttribute {att {win {}}} {
  391.     if {![string length $win]} {
  392.         set win [win::Current]
  393.     }
  394.     getWinInfo -w $win arr
  395.     return $arr($att)
  396. }
  397.  
  398. proc floatName {str} {
  399.     if {[string match "•*" $str]} {
  400.         foreach n [info globals {*Menu}] {
  401.             global $n
  402.             if {![catch {set $n}] && ([set $n] == $str)} {
  403.                 regexp {(.*)Menu} $n dummy name
  404.                 return "[string toup [string index $name 0]][string range $name 1 end]"
  405.             }
  406.         }
  407.     }
  408.     return "[string toup [string index $str 0]][string range $str 1 end]"
  409. }
  410. proc winDirty {} {
  411.     getWinInfo arr
  412.     return $arr(dirty)
  413. }
  414.  
  415. proc winReadOnly {{win ""}} {
  416.     goto [minPos]
  417.     if {$win == ""} {set win [win::Current]}
  418.     setWinInfo -w $win dirty 0
  419.     setWinInfo -w $win read-only 1
  420. }
  421.  
  422. proc stripNameCount str {
  423.     regsub { <[0-9]+>} $str {} str
  424.     return $str
  425. }
  426.  
  427. proc shrinkWindow {{shrinkWidth 0}} {
  428.     global defHeight defWidth
  429.     # These constants work for 9-pt Monaco type
  430.     set lineht 11
  431.     set htoff 22
  432.     set chwd 6
  433.     set choff 20
  434.     
  435.     set wd [lindex [getGeometry] 2]
  436.     set ht [lindex [getGeometry] 3]
  437.     set top [lindex [getGeometry] 1]
  438.     set left [lindex [getGeometry] 0]
  439.     
  440.     set mxht [expr [lindex [getMainDevice] 3] - $top - 5 -15]
  441.     set mxwd [expr [lindex [getMainDevice] 2] - $left - 5]
  442.     set mnht 120
  443.     set mnwd 200
  444.  
  445.     set htWd [fileHtWd $shrinkWidth]
  446.     set lines [lindex $htWd 0]
  447.     set chars [lindex $htWd 1]
  448.  
  449.     if {$lines <= 1} {set lines 10}
  450.     
  451.     
  452.     if {$lines > 0} {
  453.         set ht [expr {$htoff + ( $lineht * (1 + $lines)) }]
  454.     } elseif {$ht > $defHeight} {
  455.         set ht $defHeight
  456.     }
  457.     
  458.     if {$chars > 0} {
  459.         set wd [expr {$choff + ( $chwd * (2 + $chars)) }]
  460.     } elseif {$wd > $defWidth} {
  461.         set wd $defWidth
  462.     }
  463.     
  464.     if {$ht > $mxht} {set ht $mxht}
  465.     if {$wd > $mxwd} {set wd $mxwd}
  466.     if {$ht < $mnht} {set ht $mnht}
  467.     if {$wd < $mnwd} {set wd $mnwd}
  468.     sizeWin $wd $ht
  469. }
  470.  
  471. #############################################################################
  472. # Return the number of lines and the maximum number of characters in any 
  473. # line of a file.  It would be nice if there was a built-in command to
  474. # do this (i.e., compiled C code) because this is a pretty slow way to
  475. # get the maximum line width.
  476.  
  477. proc fileHtWd {{checkWidth 0}} {
  478.     set text [getText [minPos] [maxPos]] 
  479.     getWinInfo arr
  480.     set tabw [expr {$arr(tabsize) - 1}]
  481.     
  482.     set lines [split $text "\r"]
  483.     set nlines [llength $lines]
  484.  
  485.     if {$checkWidth > 1} {
  486.         set lines [eval lrange \$lines [displayedLines]]
  487.     }
  488.     
  489.     set llen 0
  490.     if {$checkWidth > 0} {
  491.         foreach line $lines {
  492.             regsub {                +∞.*$} $line {} line
  493.             regsub {    } $line {    } line
  494.             set len [string length $line]
  495.             if {[set ntab [llength [split $line "\t"]]] > 1} {
  496.                 set len [expr {$len + $tabw*($ntab-1)}]
  497.             }
  498.             if { $len > $llen} {
  499.                 set llen $len
  500.             }
  501.         }
  502.     }
  503. #    alertnote "Text Height : $nlines ; Text Width : $llen "
  504.     return [list $nlines $llen]
  505. }
  506.  
  507. # Report what range of lines are displayed in any window.
  508. # (A side effect is that the insertion point is moved to the 
  509. # top of the window, if it was previously off-screen)
  510. #
  511. proc displayedLines {{window {}}} {
  512.     if {$window == {}} { set window [win::Current] }
  513.  
  514.     bringToFront $window
  515.     set oldPos [getPos]
  516.     moveInsertionHere
  517.     set top [getPos]
  518.     set first [lindex [posToRowCol $top] 0]
  519.     moveInsertionHere -last
  520.     set bottom [getPos]
  521.     set last [lindex [posToRowCol $bottom] 0]
  522.  
  523.     if {$oldPos < $top || $oldPos > $bottom} {
  524.         goto $top
  525.     } else {
  526.         goto $oldPos
  527.     }
  528.  
  529.     return [list $first $last]
  530. }
  531.  
  532.  
  533.  
  534.  
  535.  
  536.  
  537.